home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / ansi.swg / 0030_Complete ANSI Output Unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-02-03  |  5.6 KB  |  211 lines
  1. {--------------------------------------------------------------------}
  2. (*                                                                  *)
  3. (*         Gansi.Pas -- A Pascal unit containing all of             *)
  4. (*         ANSI graphics, cursor, keyboard, and screen              *)
  5. (*         mode manipulation strings.                               *)
  6. (*                                                                  *)
  7. (*         Version 2.21   April 26th, 1991                          *)
  8. (*                                                                  *)
  9. (*                                   Greg Smith                     *)
  10. (*                                   Boulder, Co. USA               *)
  11. (*                                                                  *)
  12. {--------------------------------------------------------------------}
  13.  
  14. unit gansi;
  15.  
  16. interface
  17.  
  18. uses
  19.   Dos;
  20.  
  21. type
  22.   ansicode   = string[12]; { Maximum size for most ANSI strings }
  23.  
  24. const
  25.   hdr        = #27+'['; { ansi control sequence }
  26.   clsd       = hdr+'0J'; { Clear Everything below cursor }
  27.   clsu       = hdr+'1J'; { Clear Everything above cursor }
  28.   cls        = hdr+'2J'; { Clear Screen }
  29.   requestpos = hdr+'6n'; { request Cursor pos. StdIn rets Esc[y;xR }
  30.   delline    = hdr+'K'; { delete from cursor to EOL }
  31.   savepos    = hdr+'s'; { save cursor position }
  32.   restpos    = hdr+'u'; { restore cursor position }
  33.   cursorhome = hdr+'H'; { Home cursor }
  34.   normcolor  = hdr+'0m'; { Normal white on black }
  35.   highlight  = hdr+'1m'; { Highlight.  (Bold) }
  36.   RevVideo   = hdr+'7m'; { Reverse the FG and BG }
  37.  
  38.  
  39. function SetPos(x,y:integer): ansicode;
  40. function CursorUp(n:integer): ansicode;
  41. function CursorDown(n:integer): ansicode;
  42. function CursorRight(n:integer): ansicode;
  43. function CursorLeft(n:integer): ansicode;
  44.  
  45. function InsertChar(n:integer): ansicode;
  46. function DeleteChar(n:integer): ansicode;
  47. function InsertLine(n:integer): ansicode;
  48. function DeleteLine(n:integer): ansicode;
  49.  
  50. function SetAttr(C:integer): ansicode;
  51. function SetColor(f,b:integer): ansicode;
  52.  
  53. function SetMode(mode:integer): ansicode;
  54. function Resetmode(mode:integer): ansicode;
  55.  
  56. function SetChar(ch:char;st:string): string;
  57. function SetExtendedKey(key:integer;st:string): string;
  58.  
  59.  
  60. implementation
  61.  
  62. type  intstring = string[6];
  63.  
  64. { Misc support functions }
  65.  
  66. function bts(x:integer): intstring;
  67. var
  68.   z : intstring;
  69. begin
  70.   Str(x,z);
  71.   bts := z;
  72. end;
  73.  
  74. function HNum(n:integer): ansicode;
  75. var
  76.   z : intstring;
  77. begin
  78.   Str(n,z);
  79.   HNum := hdr+z;
  80. end;
  81.  
  82. { Cursor Control functions }
  83.  
  84. function SetPos(x,y:integer): ansicode;
  85. begin
  86.   SetPos := hnum(y)+';'+bts(x)+'H';
  87. end;
  88.  
  89. function CursorUp(n:integer): ansicode;
  90. begin
  91.   CursorUp := hnum(n)+'A';
  92. end;
  93.  
  94. function CursorDown(n:integer): ansicode;
  95. begin
  96.   CursorDown := hnum(n)+'B';
  97. end;
  98.  
  99. function CursorRight(n:integer): ansicode;
  100. begin
  101.   CursorRight := hnum(n)+'C';
  102. end;
  103.  
  104. function CursorLeft(n:integer): ansicode;
  105. begin
  106.   CursorLeft := hnum(n)+'D';
  107. end;
  108.  
  109.  
  110. { Editing Functions }
  111.  
  112. function InsertChar(n:integer): ansicode;
  113. begin
  114.   InsertChar := hnum(n)+'@';
  115. end;
  116.  
  117. function DeleteChar(n:integer): ansicode;
  118. begin
  119.   DeleteChar := hnum(n)+'P';
  120. end;
  121.  
  122. function InsertLine(n:integer): ansicode;
  123. begin
  124.   InsertLine := hnum(n)+'L';
  125. end;
  126.  
  127. function DeleteLine(n:integer): ansicode;
  128. begin
  129.   DeleteLine := hnum(n)+'M';
  130. end;
  131.  
  132.  
  133. { Color functions }
  134.  
  135. function SetAttr(C:integer): ansicode;
  136. var
  137.   x : integer;
  138.   tmp : ansicode;
  139.  
  140.   procedure ColorIdentify;
  141.   begin
  142.     case x of
  143.      0 :  tmp := tmp+'0';  { Black }
  144.      1 :  tmp := tmp+'4';  { Blue }
  145.      2 :  tmp := tmp+'2';  { Green }
  146.      3 :  tmp := tmp+'6';  { Cyan }
  147.      4 :  tmp := tmp+'1';  { Red }
  148.      5 :  tmp := tmp+'5';  { Magenta }
  149.      6 :  tmp := tmp+'3';  { Brown/Yellow }
  150.      7 :  tmp := tmp+'7';  { White }
  151.     end; { case }
  152.   end; { ColorIdentify }
  153.  
  154. begin
  155.   tmp := hdr;
  156.   if (c and $08)=1 then tmp := tmp+'1' else tmp := tmp+'0';
  157.   tmp := tmp+';3'; { common to all fgnds. }
  158.   x := c and $07; { first three bits. }
  159.   ColorIdentify; { Add Color Value digit }
  160.   tmp := tmp+';4'; { common to all bkgnds. }
  161.   x := (c and $70) shr 4;
  162.   ColorIdentify; { Add color value digit }
  163.   if (c and $80)=$80 then tmp := tmp+';5';
  164.   SetAttr := tmp+'m'; { complete ANSI code! }
  165. end; { setattr }
  166.  
  167. function SetColor(f,b:integer): ansicode;
  168. begin
  169.   b := (b shl 4); { move to high bits. }
  170.   f := (f and $0f); { zero all high bits. }
  171.   SetColor := SetAttr((b OR f)); {Create Attribute byte from values.}
  172. end; { SetColor }
  173.  
  174.  
  175. { Mode Setting Functions }
  176.  
  177. function SetMode(mode:integer): ansicode;
  178. begin
  179.   SetMode := hdr+'='+bts(mode)+'h';
  180.   { Modes:
  181.        0     40x25   Black and White
  182.        1     40x25   Color
  183.        2     80x25   Black and White
  184.        3     80x25   Color
  185.        4     320x200 color           (CGA)
  186.        5     320x200 Black and White (CGA)
  187.        6     640x200 Black and White (CGA)
  188.        7     Wrap at end of line.
  189.   }
  190. end;
  191.  
  192. function Resetmode(mode:integer): ansicode;
  193. begin
  194.   Resetmode := hdr+'='+bts(mode)+'l';  { Same modes as above }
  195. end;                                   { Wrap at EOL will turn off }
  196.  
  197. { Keyboard Re-Defining functions }
  198.  
  199. function SetChar(ch:char;st:string): string;
  200. begin
  201.   SetChar := hdr+bts(ord(ch))+';"'+st+'"p'; { when ch is pressed st is }
  202. end;                                        { sent instead of ch       }
  203.  
  204. function SetExtendedKey(key:integer;st:string): string;
  205. begin
  206.   SetExtendedKey := hdr+'0;'+bts(key)+';"'+st+'"p'; { Same as above. but the }
  207. end;                                                { Key is an extended code }
  208.  
  209.  
  210. end.
  211.